home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 03 - 1987 / 03.05 May 87 / Paint Files source / TML source / PaintFileMgr.Ipas next >
Encoding:
Text File  |  1986-10-25  |  3.8 KB  |  141 lines  |  [TEXT/EDIT]
  1. {_______________________________________________________________________
  2. PAINTFILEMGR
  3.  
  4. DESCRIPTION
  5.     Procedures for opening and displaying Paint files with
  6.     high level routines from Toolbox file manager.  This might
  7.     not work in a 128K Mac, but could probably be made to work
  8.     by reading and unpacking the file in smaller chunks.
  9.     
  10. AUTHOR
  11.     Gary B. Palmer.  Public domain. October 25, 1986.
  12.     Author reserves right to use in own programs.
  13. _______________________________________________________________________}
  14.  
  15.     
  16. procedure SFGetPaint(var theReply:SFReply);
  17. const
  18.     SFPutLeft = 100;
  19.     SFPutTop = 100;
  20. var
  21.     SFPutPt:Point;
  22.     PNTG_list:SFTypeList;
  23. begin
  24.     PNTG_list[0] := 'PNTG';
  25.     SetPt(SFPutPt, SFPutLeft, SFPutTop);
  26.     SFGetFile(SFPutPt, '', Nil, 1, PNTG_list, Nil, theReply);
  27. end;{SFGetPaint}
  28.  
  29.  
  30. procedure CloseOldFile(refNum:Integer; vRefNum:Integer);
  31. var
  32.     err:OSErr;
  33. begin
  34.     err := FSClose(refNum);
  35.     err := FlushVol(nil, vRefNum);
  36. end;{CloseOldFile}
  37.  
  38.     
  39. procedure ReadPaintFile(refNum:Integer; var PackedBitsPtr:Ptr);
  40. var
  41.     bytes:LongInt;
  42.     err:OSErr;
  43. begin
  44.     PackedBitsPtr := Nil;
  45.     err := GetEOF(refNum, bytes);                                                {FIND LOGICAL END OF FILE}
  46.     bytes := bytes - 512;                                                                    {HEADER BLOCK NOT NEEDED}
  47.     if odd(bytes) then Exit(ReadPaintFile);
  48.     PackedBitsPtr := NewPtr(bytes);                                                {MAKE A HOME FOR THE DATA}
  49.     if MemError <> noErr then begin 
  50.         Exit(ReadPaintFile);
  51.         PackedBitsPtr := Nil;
  52.         end;
  53.     err := SetFPos(refNum, FSFromStart, 512);                 {START AT BEGINNING OF DATA}
  54.     err := FSRead(refNum, bytes, PackedBitsPtr);        {READ THE DATA TO THE BUFFER}
  55. end;{ReadPaintFile}
  56.  
  57.  
  58. procedure GetPaintImage(var ImagePtr:Ptr);
  59. const
  60.     SizeOfPaintImage = 51840;
  61. var
  62.     refNum:Integer;
  63.     theReply:SFReply;
  64.     err:OSErr;
  65.     packedBitsPtr:Ptr;
  66.     destPtr, SrcPtr:Ptr;
  67.     saveStart:longInt;
  68.     bytesUnPacked:Integer;
  69.     
  70. begin
  71.  
  72.     ImagePtr := Nil;
  73.  
  74.     SFGetPaint(theReply);
  75.     
  76.     with theReply do
  77.     
  78.         if not good then Exit(GetPaintImage)
  79.         else begin
  80.         
  81.             err := FSOpen(fName, vRefNum, refNum);
  82.             
  83.             if err <> 0 then Exit(GetPaintImage);
  84.             
  85.             ReadPaintFile(refNum, packedBitsPtr); 
  86.             {RETURNS A POINTER TO THE PACKED DATA.  SEE ABOVE}
  87.             
  88.             CloseOldFile(refNum, vRefNum);                             {CLOSE FILE IMMEDIATELY}
  89.             
  90.             if packedBitsPtr = Nil then Exit(GetPaintImage);
  91.             
  92.             ImagePtr := NewPtr(SizeOfPaintImage); {MAKE A HOME FOR THE IMAGE}
  93.             
  94.             if MemError <> 0 then Exit(GetPaintImage);
  95.             
  96.             {POINTERS TO BE USED BY UNPACKBITS WILL BE INCREMENTED, SO SAVE
  97.             OLD POINTERS BY CREATING A COUPLE OF SCAPEGOATS:SRCPTR AND DESTPTR}
  98.                 SrcPtr := packedBitsPtr;    {SRCPTR WILL BE INCREMENTED}
  99.                 DestPtr := ImagePtr;    {DESTPTR WILL BE INCREMENTED}
  100.                 
  101.                 {A PAINT IMAGE HAS MORE BYTES THAN CAN BE REPRESENTED BY AN
  102.                 INTEGER, AND UNPACKBITS ACCEPTS ONLY INTEGERS, SO UNPACK
  103.                 ONLY HALF THE BYTES AT A TIME.}
  104.                 
  105.                 saveStart := ord(DestPtr);
  106.                 UnpackBits(SrcPtr, DestPtr, SizeOfPaintImage div 2);
  107.                 bytesUnPacked := ord(DestPtr) - saveStart;
  108.                 
  109.                 {THE FINAL UNPACKING STARTS FROM THE NEW VALUES OF SRCPTR.}
  110.                 UnpackBits(SrcPtr, DestPtr, SizeOfPaintImage - bytesUnPacked);
  111.                 
  112.                 DisposPtr(packedBitsPtr);
  113.             
  114.                 end;
  115. end;{GetPaintImage}
  116.  
  117.  
  118. procedure DisplayPaintFile(ImagePtr:Ptr);
  119. var
  120.     pageBits:BitMap;
  121.     drawRect:Rect;
  122. begin
  123.  
  124. if ImagePtr = Nil then Exit(DisplayPaintFile);
  125.  
  126. {SET UP AN APPROPRIATE BITMAP TO SEND TO COPYBITS}
  127.     with pageBits do begin
  128.         baseAddr := ImagePtr;                         {GIVE THE BUFFER TO THE BITMAP}
  129.         rowBytes := 72;                                         {ROWBYTES OF PAINT IMAGE}
  130.         SetRect(bounds, 0, 0, 576, 720);     {ENCLOSES PAINT IMAGE}
  131.         end;
  132.     
  133.     {ASSUMES THE MAIN PROGRAM HAS OPENED A WINDOW APPROX
  134.     THE SAME SIZE AS THE SCREEN AND SET THE PORT}
  135.     SetRect(drawRect, 148, 0, 364, 270); {3/8 NORMAL SIZE, CENTERED}
  136.     copyBits(pageBits, thePort^.portbits, pagebits.bounds, drawRect,
  137.         srcCopy, Nil);
  138.     
  139. end;{DisplayPaintFile}
  140.  
  141. {_______________________________________________________________________}